home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpc09905c.lha / fpc / units / crt.pp < prev    next >
Text File  |  1998-09-21  |  26KB  |  1,022 lines
  1. {
  2.     $Id: crt.pp,v 1.5 1998/09/14 20:21:53 carl Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1998 by Nils Sjoholm and Carl Eric Codere
  5.  
  6.     See the file COPYING.FPC, included in this distribution,
  7.     for details about the copyright.
  8.  
  9.     This program is distributed in the hope that it will be useful,
  10.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  11.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12.  
  13.  **********************************************************************}
  14.  
  15.  
  16. unit Crt;
  17.  
  18. {--------------------------------------------------------------------}
  19. { LEFT TO DO:                                                        }
  20. {--------------------------------------------------------------------}
  21. { o Write special characters are not recognized                      }
  22. { o Write does not take care of window coordinates yet.              }
  23. { o Read does not recognize the special editing characters           }
  24. { o Read does not take care of window coordinates yet.               }
  25. { o Readkey extended scancode is not correct yet                     }
  26. { o Color mapping only works for 4 colours                           }
  27. { o ClrScr, DeleteLine, InsLine do not work with window coordinates  }
  28. {--------------------------------------------------------------------}
  29.  
  30.  
  31.  
  32. Interface
  33.  
  34. Const
  35. { Controlling consts }
  36.   Flushing=false;                       {if true then don't buffer output}
  37.   ScreenWidth  = 80;
  38.   ScreenHeight = 25;
  39.  
  40. { CRT modes }
  41.   BW40          = 0;            { 40x25 B/W on Color Adapter }
  42.   CO40          = 1;            { 40x25 Color on Color Adapter }
  43.   BW80          = 2;            { 80x25 B/W on Color Adapter }
  44.   CO80          = 3;            { 80x25 Color on Color Adapter }
  45.   Mono          = 7;            { 80x25 on Monochrome Adapter }
  46.   Font8x8       = 256;          { Add-in for ROM font }
  47.  
  48. { Mode constants for 3.0 compatibility }
  49.   C40           = CO40;
  50.   C80           = CO80;
  51.  
  52. {
  53.   When using this color constants on the Amiga
  54.   you can bet that they don't work as expected.
  55.   You never know what color the user has on
  56.   his Amiga. Perhaps we should do a check of
  57.   the number of bitplanes (for number of colors)
  58.  
  59.   The normal 4 first pens for an Amiga are
  60.  
  61.   0 LightGrey
  62.   1 Black
  63.   2 White
  64.   3 Blue
  65.  
  66. }
  67.  
  68. { Foreground and background color constants  }
  69.   Black         = 1;  { normal pen for amiga }
  70.   Blue          = 3;  { windowborder color   }
  71.   Green         = 15;
  72.   Cyan          = 7;
  73.   Red           = 4;
  74.   Magenta       = 5;
  75.   Brown         = 6;
  76.   LightGray     = 0;  { canvas color         }
  77.  
  78. { Foreground color constants }
  79.   DarkGray      = 8;
  80.   LightBlue     = 9;
  81.   LightGreen    = 10;
  82.   LightCyan     = 11;
  83.   LightRed      = 12;
  84.   LightMagenta  = 13;
  85.   Yellow        = 14;
  86.   White         = 2;  { third color on amiga }
  87.  
  88. { Add-in for blinking }
  89.   Blink         = 128;
  90.  
  91. {Other Defaults}
  92.   LastMode   : Word = 3;
  93.   WindMin    : Word = $0;
  94.   WindMax    : Word = $184f;
  95. { These don't change anything if they are modified }
  96.   CheckSnow  : Boolean = FALSE;
  97.   DirectVideo: Boolean = FALSE;
  98. var
  99.   TextAttr : BYTE;
  100.   { CheckBreak have to make this one to a function for Amiga }
  101.   CheckEOF : Boolean;
  102.  
  103. Procedure AssignCrt(Var F: Text);
  104. Function  KeyPressed: Boolean;
  105. Function  ReadKey: Char;
  106. Procedure TextMode(Mode: Integer);
  107. Procedure Window(X1, Y1, X2, Y2: BYTE);
  108. Procedure GoToXy(X: byte; Y: byte);
  109. Function  WhereX: Byte;
  110. Function  WhereY: Byte;
  111. Procedure ClrScr;
  112. Procedure ClrEol;
  113. Procedure InsLine;
  114. Procedure DelLine;
  115. Procedure TextColor(Color: Byte);
  116. Procedure TextBackground(Color: Byte);
  117. Procedure LowVideo;
  118. Procedure HighVideo;
  119. Procedure NormVideo;
  120. Procedure Delay(DTime: Word);
  121. Procedure Sound(Hz: Word);
  122. Procedure NoSound;
  123.  
  124. { Extra functions }
  125.  
  126. Procedure CursorOn;
  127. Procedure CursorOff;
  128. Function CheckBreak: Boolean;
  129.  
  130. Implementation
  131.  
  132. {
  133.   The definitions of TextRec and FileRec are in separate files.
  134. }
  135. {$i textrec.inc}
  136. {$i filerec.inc}
  137.  
  138. var
  139.   maxcols,maxrows : longint;
  140.  
  141. CONST
  142.   { This is used to make sure that readkey returns immediately }
  143.   { if keypressed was used beforehand.                         }
  144.   KeyPress : char = #0;
  145.   _LVODisplayBeep = -96;
  146.  
  147.  
  148. Type
  149.  
  150.     pInfoData = ^tInfoData;
  151.     tInfoData = packed record
  152.         id_NumSoftErrors        : Longint;      { number of soft errors on disk }
  153.         id_UnitNumber           : Longint;      { Which unit disk is (was) mounted on }
  154.         id_DiskState            : Longint;      { See defines below }
  155.         id_NumBlocks            : Longint;      { Number of blocks on disk }
  156.         id_NumBlocksUsed        : Longint;      { Number of block in use }
  157.         id_BytesPerBlock        : Longint;
  158.         id_DiskType             : Longint;      { Disk Type code }
  159.         id_VolumeNode           : Longint;         { BCPL pointer to volume node }
  160.         id_InUse                : Longint;      { Flag, zero if not in use }
  161.     end;
  162.  
  163. { *  List Node Structure.  Each member in a list starts with a Node * }
  164.  
  165.   pNode = ^tNode;
  166.   tNode = packed Record
  167.     ln_Succ,                { * Pointer to next (successor) * }
  168.     ln_Pred  : pNode;       { * Pointer to previous (predecessor) * }
  169.     ln_Type  : Byte;
  170.     ln_Pri   : Shortint;    { * Priority, for sorting * }
  171.     ln_Name  : PChar;       { * ID string, null terminated * }
  172.   End;  { * Note: Integer aligned * }
  173.  
  174. { normal, full featured list }
  175.  
  176.     pList = ^tList;
  177.     tList = packed record
  178.     lh_Head     : pNode;
  179.     lh_Tail     : pNode;
  180.     lh_TailPred : pNode;
  181.     lh_Type     : Byte;
  182.     l_pad       : Byte;
  183.     end;
  184.  
  185.     pMsgPort = ^tMsgPort;
  186.     tMsgPort = packed record
  187.     mp_Node     : tNode;
  188.     mp_Flags    : Byte;
  189.     mp_SigBit   : Byte;      { signal bit number    }
  190.     mp_SigTask  : Pointer;   { task to be signalled (TaskPtr) }
  191.     mp_MsgList  : tList;     { message linked list  }
  192.     end;
  193.  
  194.     pMessage = ^tMessage;
  195.     tMessage = packed record
  196.     mn_Node       : tNode;
  197.     mn_ReplyPort  : pMsgPort;   { message reply port }
  198.     mn_Length     : Word;       { message len in bytes }
  199.     end;
  200.  
  201.     pIOStdReq = ^tIOStdReq;
  202.     tIOStdReq = packed record
  203.     io_Message  : tMessage;
  204.     io_Device   : Pointer;      { device node pointer  }
  205.     io_Unit     : Pointer;      { unit (driver private)}
  206.     io_Command  : Word;         { device command }
  207.     io_Flags    : Byte;
  208.     io_Error    : Shortint;     { error or warning num }
  209.     io_Actual   : Longint;      { actual number of bytes transferred }
  210.     io_Length   : Longint;      { requested number bytes transferred}
  211.     io_Data     : Pointer;      { points to data area }
  212.     io_Offset   : Longint;      { offset for block structured devices }
  213.     end;
  214.  
  215.     pIntuiMessage = ^tIntuiMessage;
  216.     tIntuiMessage = packed record
  217.         ExecMessage     : tMessage;
  218.         IClass          : Longint;
  219.         Code            : Word;
  220.         Qualifier       : Word;
  221.         IAddress        : Pointer;
  222.         MouseX,
  223.         MouseY          : Word;
  224.         Seconds,
  225.         Micros          : Longint;
  226.         IDCMPWindow     : Pointer;
  227.         SpecialLink     : pIntuiMessage;
  228.     end;
  229.  
  230.     pWindow = ^tWindow;
  231.     tWindow = packed record
  232.         NextWindow      : pWindow;      { for the linked list in a screen }
  233.         LeftEdge,
  234.         TopEdge         : Integer;      { screen dimensions of window }
  235.         Width,
  236.         Height          : Integer;      { screen dimensions of window }
  237.         MouseY,
  238.         MouseX          : Integer;      { relative to upper-left of window }
  239.         MinWidth,
  240.         MinHeight       : Integer;      { minimum sizes }
  241.         MaxWidth,
  242.         MaxHeight       : Word;         { maximum sizes }
  243.         Flags           : Longint;      { see below for defines }
  244.         MenuStrip       : Pointer;      { the strip of Menu headers }
  245.         Title           : PChar;        { the title text for this window }
  246.         FirstRequest    : Pointer;      { all active Requesters }
  247.         DMRequest       : Pointer;      { double-click Requester }
  248.         ReqCount        : Integer;      { count of reqs blocking Window }
  249.         WScreen         : Pointer;      { this Window's Screen }
  250.         RPort           : Pointer;      { this Window's very own RastPort }
  251.         Bor